home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr47 / fvideo.zip / FUNVID.PRG < prev    next >
Text File  |  1995-01-31  |  11KB  |  422 lines
  1. #include system.hdr
  2. #include string.hdr
  3. #include screen.hdr
  4. #include error.hdr
  5. #include io.hdr
  6. #include pick.hdr
  7. #include math.hdr
  8. #include date.hdr
  9. #include xsvforce.hdr
  10.  
  11. #PRAGMA W_FUNC_PROC-
  12. #PRAGMA W_PRECISION-
  13. #PRAGMA W_GET_LOCAL-
  14. #PRAGMA W_INDIRECT-
  15. #PRAGMA W_EXTERN-
  16.  
  17. #define  TRUE            .T.
  18. #define  FALSE           .F.
  19. #define  NULL            ""
  20.  
  21. #DEFINE  BLACK_LIGHT_GREY     007
  22. #DEFINE  BLACK_LIGHT_BLUE     009
  23. #DEFINE  BLACK_LIGHT_GREEN    010
  24. #DEFINE  BLACK_LIGHT_CYAN     011
  25. #DEFINE  BLACK_LIGHT_RED      012
  26. #DEFINE  BLACK_YELLOW         014
  27. #DEFINE  BLACK_WHITE          015
  28. #DEFINE  CYAN_BLACK           048
  29. #DEFINE  CYAN_YELLOW          062
  30.  
  31. #DEFINE  K_TAB               9
  32. #DEFINE  K_ENTER            13
  33. #DEFINE  K_ESC              27
  34. #DEFINE  K_F7            32833
  35. #DEFINE  K_LEFT          32843
  36. #DEFINE  K_RIGHT         32845
  37.  
  38. VARDEF EXTERN
  39.    BYTE                  __color_std, __color_enhcd
  40.    UINT                  __errcode, __max_row, __max_col
  41. ENDDEF
  42.  
  43. VARDEF
  44.    CHAR                  Work, ADrvs
  45.    CHAR(80)              SCDR, C_Dir
  46.    CHAR(44)              FStr
  47.    CHAR(40)              A_Path
  48.    CHAR(18)              KStr
  49.    CHAR(12)              A_Srch
  50.    CHAR(1)               A_Drive, C_Drv
  51.    INT                   SCD, smod, cmod, ok
  52.    INT                   Next_Row, Start_Col, Start_Row, DC
  53.    INT                   Str_Pos, End_Pos, Hld_Pos, RC
  54.    INT                   F_Len, DNbr, DVal, PUR, PUC, PDR, PLR, PLC
  55.    INT                   FNbr, FVal, UR, UC, LR, LC
  56.    UINT                  Counter, gkey, pick_key, C_Drive
  57.    LONG                  FLst, DLst
  58. ENDDEF
  59.  
  60. FUNCTION INT _getmode PROTOTYPE
  61.  
  62. FUNCTION INT _videomode PROTOTYPE
  63.   PARAMETERS VALUE INT Mode
  64.  
  65. FUNCTION CHAR _drivestr PROTOTYPE
  66.   PARAMETERS CONST CHAR ADrv
  67.  
  68. PROCEDURE Force_Error
  69.   ?? 'RTE-'+I_STR(__errcode)+":"
  70.   ?? e_message()
  71.   SELECT_DRIVE(SCD)
  72.   CHDIR(SCDR)
  73.   QUIT __errcode
  74. ENDPRO
  75.  
  76. FUNCTION UINT get_prc
  77.   VARDEF
  78.     UINT                  k
  79.   ENDDEF
  80.   k = LASTKEY()
  81.   DO CASE
  82.     CASE k = &K_LEFT
  83.       pick_key = &K_LEFT
  84.       RETURN &K_ESC
  85.     CASE k = &K_RIGHT
  86.       pick_key = &K_RIGHT
  87.       RETURN &K_ESC
  88.     CASE k = &K_ENTER
  89.       pick_key = &K_ENTER
  90.       RETURN &K_ENTER
  91.     CASE k = &K_ESC
  92.       pick_key = &K_ESC
  93.       RETURN &K_ESC
  94.   ENDCASE
  95.   RETURN k
  96. ENDPRO
  97.  
  98.  
  99. PROCEDURE Pick_Files
  100.   VARDEF
  101.      CHAR                  SDir
  102.      CHAR(80)              CDD
  103.      CHAR(12)              S_FFil
  104.      CHAR(10)              S_Siz
  105.      CHAR(8)               S_Dat, S_Fil, S_Tim
  106.      CHAR(3)               S_Ext
  107.      CHAR(1)               S_Drv
  108.      INT                   S_Len, S_Col, S_End, NF
  109.      LOGICAL               D_Flag, F_Flag, G_Flag, N_Flag, S_Flag
  110.   ENDDEF
  111.  
  112.   D_Flag = &TRUE
  113.   PDR    = I_TRUNC((__max_row-1)/2)
  114.   PLR    = PDR-1
  115.  
  116.   DO WHILE D_Flag
  117.     FLst    = PICK_INIT()
  118.     DLst    = PICK_INIT()
  119.     RC      = 0
  120.     NF      = 0
  121.     DC      = 0
  122.     Hld_Pos = 0
  123.     Str_Pos = 0
  124.     End_Pos = 0
  125.     S_FFil  = &NULL
  126.     S_Fil   = &NULL
  127.     S_Ext   = &NULL
  128.     S_Siz   = &NULL
  129.     S_Dat   = &NULL
  130.     S_Tim   = &NULL
  131.     S_Drv   = &NULL
  132.     FStr    = &NULL
  133.     KStr    = &NULL
  134.  
  135.     CDD     = &NULL
  136.     S_Flag  = &FALSE
  137.     N_Flag  = &FALSE
  138.     C_Drive = CURDRIVE()
  139.     C_Dir   = RTRIM(CURDIR(0))
  140.     CDD     = CHR(C_Drive + 65)+":"+C_Dir
  141.     SDir    = CDD
  142.     SET DEFAULT TO CDD
  143.  
  144.     IF FIND_FIRST('*.*',&FIND_SUBDIR)
  145.       REPEAT
  146.         IF FIND_FATTR() = 0x10
  147.           DC = DC + 1
  148.           S_FFil  = RTRIM(FIND_FSTR())
  149.           S_Ext   = RTRIM(FIND_FEXT())
  150.           Hld_Pos = AT(".",S_FFil)
  151.           IF Hld_Pos > 1
  152.             S_Fil = LEFT(S_FFil,Hld_Pos-1)
  153.             S_Ext = S_Ext + SPACE(3 - LEN(S_Ext))
  154.           ELSE
  155.             S_Fil = LEFT(S_FFil,8)
  156.             S_Ext = "   "
  157.           ENDIF
  158.           S_Fil = S_Fil + SPACE(8 - LEN(S_Fil))
  159.           S_Fil = RTRIM(S_Fil)
  160.           IF RIGHT(S_Fil,1) = "\"
  161.             S_Fil = LEFT(S_Fil, LEN(S_Fil)-1)
  162.           ENDIF
  163.           S_Fil = S_Fil + SPACE(8 - LEN(S_Fil))
  164.           S_Siz = '<DIR>'
  165.           KStr  = S_Fil+" "+S_Ext+" "+S_Siz
  166.           PICK_ADD(DLst, KStr)
  167.         ENDIF
  168.       UNTIL .NOT. FIND_NEXT()
  169.     ENDIF
  170.  
  171.     IF FIND_FIRST(A_Srch,&FIND_ANYFILE)
  172.       REPEAT
  173.         IF ((FIND_FATTR() = 0x20) .OR. (FIND_FATTR() = 0x00))
  174.           RC = RC + 1
  175.           S_FFil  = RTRIM(FIND_FSTR())
  176.           S_Ext   = RTRIM(FIND_FEXT())
  177.           Hld_Pos = AT(".",S_FFil)
  178.           IF Hld_Pos > 1
  179.             S_Fil = LEFT(S_FFil,Hld_Pos-1)
  180.             S_Ext = S_Ext + SPACE(3 - LEN(S_Ext))
  181.           ELSE
  182.             S_Fil = LEFT(S_FFil,8)
  183.             S_Ext = "   "
  184.           ENDIF
  185.           S_Fil = S_Fil + SPACE(8 - LEN(S_Fil))
  186.           S_Siz = SPACE(10 - LEN(I_STR(FIND_FSIZE()))) + I_STR(FIND_FSIZE())
  187.           S_Dat = DTOC(FIND_FDATE())
  188.           S_Tim = FIND_FTIME()
  189.           FStr = "  "+S_Fil+" "+S_Ext+" "+S_Siz+" "+S_Dat+" "+S_Tim+" "
  190.           PICK_ADD(FLst, FStr)
  191.         ENDIF
  192.       UNTIL .NOT. FIND_NEXT()
  193.     ENDIF
  194.     IF RC = 0
  195.       RC = RC + 1
  196.       NF = 1
  197.       FStr  = "  No files found..."
  198.       PICK_ADD(FLst, FStr)
  199.     ENDIF
  200.  
  201.     IF RC > 0
  202.       @ 01,01 TO __max_row-1,78 CLEAR
  203.       IF DC > 0
  204.         PUR = 03
  205.         PUC = 52
  206.         PLC = 69
  207.         __color_std = &CYAN_BLACK
  208.         @ 01,51 ?? " Directories"
  209.         __color_std = &CYAN_YELLOW
  210.         ?? "(" + I_STR(DC) + ') '
  211.         __color_std = &CYAN_BLACK
  212.         FILL(02,51,PDR,70,&SINGLE_BOX," ",&BLACK_LIGHT_BLUE,&CYAN_BLACK,0)
  213.         __color_std = &BLACK_LIGHT_GREEN
  214.         @ PDR,54 ?? " ENTER "
  215.         __color_std = &BLACK_YELLOW
  216.         @ PDR,61 ?? "or "
  217.         __color_std = &BLACK_LIGHT_CYAN
  218.         @ PDR,64 ?? "Tab "
  219.         DVal = 1
  220.         PICK_LIST(DLst, PUR, PUC, PLR, PLC, DVal, &TRUE, &FALSE)
  221.       ENDIF
  222.       __color_std = &CYAN_BLACK
  223.       @ 01,02 ?? " Files"
  224.       __color_std = &CYAN_YELLOW
  225.       IF NF = 0
  226.         ?? "(" + I_STR(RC) + ') '
  227.       ELSE
  228.         ?? '(0) '
  229.       ENDIF
  230.       __color_std = &CYAN_BLACK
  231.       FILL(02,01,__max_row-1,46,&SINGLE_BOX," ",&BLACK_LIGHT_BLUE,&CYAN_BLACK,0)
  232.       __color_std = &BLACK_YELLOW
  233.       @ 02,02 ?? "  FileName Ext -- Size -- - Date - - Time -"
  234.       __color_std = &BLACK_LIGHT_GREEN
  235.       @ __max_row-1,07 ?? " ENTER "
  236.       __color_std = &BLACK_YELLOW
  237.       @ __max_row-1,14 ?? "or "
  238.       __color_std = &BLACK_LIGHT_CYAN
  239.       @ __max_row-1,17 ?? "Tab  "
  240.       __color_std = &BLACK_WHITE
  241.       @ __max_row-1,22 ?? "F7=Drive  "
  242.       __color_std = &BLACK_LIGHT_RED
  243.       @ __max_row-1,32 ?? "Esc=Quit "
  244.       CURSOR_OFF()
  245.       UR   = 03
  246.       UC   = 02
  247.       LR   = __max_row-2
  248.       LC   = 45
  249.       FVal = 1
  250.       DO WHILE .NOT. S_Flag
  251.         PICK_LIST(FLst, UR, UC, LR, LC, FVal, &FALSE, &TRUE)
  252.         IF LASTKEY() == &K_TAB
  253.           PICK_LIST(DLst, PUR, PUC, PLR, PLC, DVal, &FALSE, &TRUE)
  254.           IF LASTKEY() <> &K_ESC
  255.             KStr = PICK_STR(DLst,DVal)
  256.             IF SUBSTR(KStr,10,3) <> "   "
  257.               CHDIR(RTRIM(SUBSTR(KStr,1,8))+"."+SUBSTR(KStr,10,3))
  258.             ELSE
  259.               CHDIR(RTRIM(SUBSTR(KStr,1,8)))
  260.             ENDIF
  261.             A_Path = RTRIM(CURDIR(0))
  262.             __color_std = &BLACK_LIGHT_CYAN
  263.             @ 02,17 ?? SPACE(40)
  264.             @ 02,17 ?? A_Path
  265.           ELSE
  266.             D_Flag = &FALSE
  267.           ENDIF
  268.           S_Flag = &TRUE
  269.         ELSE
  270.           IF LASTKEY() = &K_F7
  271.             CURSOR_ON()
  272.             S_Col = 08
  273.             S_End = 08+LEN(ADrvs)-1
  274.             SAVE_AREA(01,01,01,S_End+1)
  275.             __color_std = &CYAN_BLACK
  276.             @ 01,01 ?? 'Drive?'
  277.             __color_std = &BLACK_WHITE
  278.             @ 01,08 TO 01,S_End+1 CLEAR
  279.             __color_std   = &BLACK_LIGHT_CYAN
  280.             __color_enhcd = &CYAN_BLACK
  281.             G_Flag = &FALSE
  282.             DO WHILE .NOT. G_Flag
  283.               @ 01,08 ?? ADrvs
  284.               S_Drv = SUBSTR(ADrvs,S_Col-7,1)
  285.               @ 1,S_Col GET S_Drv PICTURE "@!" FILTER get_prc()
  286.               READ
  287.               DO CASE
  288.                 CASE pick_key = &K_RIGHT
  289.                   S_Col = S_Col + 1
  290.                   IF S_Col > S_End
  291.                     S_Col = 08
  292.                   ENDIF
  293.                   pick_key = 0
  294.                 CASE pick_key = &K_LEFT
  295.                   S_Col = S_Col - 1
  296.                   IF S_Col < 08
  297.                     S_Col = S_End
  298.                   ENDIF
  299.                   pick_key = 0
  300.                 CASE pick_key = &K_ENTER
  301.                   C_Drv  = S_Drv
  302.                   N_Flag = &TRUE
  303.                   G_Flag = &TRUE
  304.                   __color_std = &BLACK_LIGHT_CYAN
  305.                   A_Drive = C_Drv
  306.                   @ 02,08 ?? A_Drive
  307.                 CASE pick_key = &K_ESC
  308.                   S_Drv = &NULL
  309.                   G_Flag = &TRUE
  310.                   D_Flag = &FALSE
  311.               ENDCASE
  312.             ENDDO
  313.             CURSOR_OFF()
  314.             RESTORE_AREA()
  315.             __color_std = &CYAN_BLACK
  316.           ELSE
  317.             D_Flag = &FALSE
  318.           ENDIF
  319.           S_Flag = &TRUE
  320.         ENDIF
  321.       ENDDO
  322.       IF N_Flag
  323.         SELECT_DRIVE(ASC(C_Drv) - 65)
  324.         A_Path = RTRIM(CURDIR(0))
  325.         __color_std = &BLACK_LIGHT_CYAN
  326.         @ 02,17 ?? SPACE(40)
  327.         @ 02,17 ?? A_Path
  328.       ENDIF
  329.       CURSOR_ON()
  330.       __color_std = &BLACK_LIGHT_GREY
  331.     ENDIF
  332.   ENDDO
  333.   PICK_CLEAR(FLst)
  334.   PICK_CLEAR(DLst)
  335.   @ 01,01 TO __max_row-1,78 CLEAR
  336.   SELECT_DRIVE(SCD)
  337.   CHDIR(SCDR)
  338.   A_Path = RTRIM(CURDIR(0))
  339.   __color_std = &BLACK_LIGHT_GREY
  340. ENDPRO
  341.  
  342. PROCEDURE force_main
  343.  
  344.   ON ERROR DO FORCE_Error
  345.  
  346.   INITXS()
  347.  
  348.   ADrvs = _drivestr(Work)
  349.  
  350.   A_Path = RTRIM(CURDIR(0))
  351.   A_Srch = '*.*'
  352.   SCD  = CURDRIVE()
  353.   SCDR = CHR(SCD + 65)+":"+RTRIM(CURDIR(0))
  354.  
  355.   smod = _getmode()
  356.   SAVE_SCREEN()
  357.   Start_Row = ROW()
  358.   Start_Col = COL()
  359.  
  360.   CLEAR
  361.   @ 10,01 ?? 'Setting modes...please press any key.'
  362.   REPEAT
  363.     gkey = GET_KEY()
  364.   UNTIL (gkey == &K_ENTER)
  365.   cmod = 28
  366.   ok   = _videomode(cmod)
  367.   if ok <> 0
  368.     @ 10,01 ?? 'UH-OH.  28 line mode not set.'
  369.   else
  370.     @ 10,01 ?? 'OK.  28 line mode set...please press any key.'
  371.     REPEAT
  372.       gkey = GET_KEY()
  373.     UNTIL (gkey == &K_ENTER)
  374.     __max_row = 28
  375.     CLEAR
  376.     Pick_Files()
  377.   endif
  378.  
  379.   CLEAR
  380.   cmod = 43
  381.   ok   = _videomode(cmod)
  382.   if ok <> 0
  383.     @ 10,01 ?? 'UH-OH.  43 line mode not set.'
  384.   else
  385.     @ 10,01 ?? 'OK.  43 line mode set...please press any key.'
  386.     REPEAT
  387.       gkey = GET_KEY()
  388.     UNTIL (gkey == &K_ENTER)
  389.     __max_row = 43
  390.     CLEAR
  391.     Pick_Files()
  392.   endif
  393.  
  394.   CLEAR
  395.   cmod = 50
  396.   ok   = _videomode(cmod)
  397.   if ok <> 0
  398.     @ 10,01 ?? 'UH-OH.  50 line mode not set.'
  399.   else
  400.     @ 10,010 ?? 'OK.  50 line mode set...please press any key.'
  401.     REPEAT
  402.       gkey = GET_KEY()
  403.     UNTIL (gkey == &K_ENTER)
  404.     __max_row = 50
  405.     CLEAR
  406.     Pick_Files()
  407.   endif
  408.  
  409.   CLEAR
  410.   ok = _videomode(smod)
  411.   @ 10,01 ?? 'Original mode reset...please press any key.'
  412.   REPEAT
  413.     gkey = GET_KEY()
  414.   UNTIL (gkey == &K_ENTER)
  415.  
  416.   SELECT_DRIVE(SCD)
  417.   CHDIR(SCDR)
  418.   RESTORE_AREA()
  419.   @ Start_Row, Start_Col
  420.  
  421. ENDPRO
  422.